home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / room3d / mmain.bas < prev    next >
BASIC Source File  |  1999-05-18  |  50KB  |  1,142 lines
  1. Attribute VB_Name = "mMain"
  2. Option Explicit
  3. 'Almost all this module (except for buildworld and checkKeys)
  4. 'Was taken from Wolfgang Kienreich's Xdemo3D example
  5. 'Hardware support code was also fixed for me by Wolfgang.... many, many,
  6. 'thanx for that
  7.  
  8. 'Variables for 3d objects in the scene
  9. Global ObjectFrame(1 To 2) As IDirect3DRMFrame2       ' Frame to hold object
  10. Public RMLight(1 To 2) As IDirect3DRMFrame
  11.  
  12. 'Variables holding DDraw and D3DRM instances ...
  13. Public G_oDDInstance As IDirectDraw                 ' Instance of DirectDraw interface
  14. Public G_oD3DInstance As IDirect3DRM                ' Instance of Direct3DRM interface
  15. ' Variables for primary D3DRM display system ...
  16. Public RMDevice As IDirect3DRMDevice2           ' Device to use for Direct3DRM operations
  17. Public RMViewport As IDirect3DRMViewPort        ' Viewport for Direct3DRM to display results in
  18. Public RMScene As IDirect3DRMFrame2       ' Top level frame that contains all other frames
  19. Public RMCamera As IDirect3DRMFrame2                ' Frame to contain the camera; The viewport is created from this frame
  20. Public RMDriver As tD3DDriver                   ' Driver for use with Direct3DRM
  21. Public RMDriverExist As Boolean               ' Flag holding presence of driver (equals driver enumeration success)
  22. Public G_dCamPosLookup(359) As D3DVECTOR            ' Lookup table of position values for camera
  23. Public G_nCamPosCurrent As Integer                  ' Current position of camera according to lookup table
  24. Global BufferDC As Long
  25. ' Variables for DirectDraw blit system ...
  26. Public G_oDDPrimary As IDirectDrawSurface3          ' Primary DirectDraw surface that is displayed on the form
  27. Public G_oDDBackbuffer As IDirectDrawSurface3       ' Backbuffer DirectDraw surface that is flipped onto the primary
  28. Public G_dDDWindow(0) As tDDWindow                  ' Buffers holding windows for effects
  29.  
  30. ' Various variables ...
  31. Public G_nFrameCount As Long                       ' Global framecounter
  32. Public G_nFrameAvg As Double                       ' Global average frames per second
  33.  
  34. ' Various constants
  35.     Public Const PIFACTOR = 0.0174532
  36.  
  37. ' Types for use with XDemo3D ...
  38.     ' Driver type for enumeration of D3D driver
  39.     Public Type tD3DDriver
  40.       DESC    As String                         ' Driver description
  41.       NAME    As String                         ' Driver name
  42.       GUID    As Byte                           ' Unique interface ID for accessing driver
  43.       GUID1   As Byte                           ' ...
  44.       GUID2   As Byte                           ' ...
  45.       GUID3   As Byte                           ' ...
  46.       GUID4   As Byte                           ' ...
  47.       GUID5   As Byte                           ' ...
  48.       GUID6   As Byte                           ' ...
  49.       GUID7   As Byte                           ' ...
  50.       GUID8   As Byte                           ' ...
  51.       GUID9   As Byte                           ' ...
  52.       GUID10  As Byte                           ' ...
  53.       GUID11  As Byte                           ' ...
  54.       GUID12  As Byte                           ' ...
  55.       GUID13  As Byte                           ' ...
  56.       GUID14  As Byte                           ' ...
  57.       GUID15  As Byte                           ' ...
  58.       DEVDESC As D3DDEVICEDESC                  ' Device description for use by D3DRM
  59.       HDW     As Boolean                        ' Device is hardware
  60.       EMU     As Boolean                        ' Device is software-emulated
  61.       RGB     As Boolean                        ' Device has rgb caps
  62.       MONO    As Boolean                        ' Device has mono ramp caps
  63.     End Type
  64.     ' Viewport window for scrolling effects windows
  65.     Public Type tDDWindow
  66.         nX As Integer
  67.         nY As Integer
  68.         nDX As Integer
  69.         nDY As Integer
  70.         oDDSurface As IDirectDrawSurface3
  71.         dRenderArea As RECT
  72.     End Type
  73.     Global PickInfo As String
  74. ' APPERROR: Reports application errors and terminates application properly
  75. Public Sub AppError(nNumber As Long, sText As String, sSource As String)
  76.  
  77.     ' Enable error handling
  78.     On Error Resume Next
  79.     
  80.     ' Cleanup
  81.     Call AppTerminate
  82.     
  83.     ' Display error
  84.     MsgBox "ERROR: " & IIf(InStr(1, UCase(sText), "AUTOM") > 0, "DirectX reports '" & GetDXError(nNumber) & "'", " Application reports '" & sText & "'") & vbCrLf & "SOURCE: " & sSource, vbCritical + vbOKOnly, "XDEMO3D"
  85.     ' Terminate program
  86.     End
  87. End Sub
  88. Public Sub AppInitialize() 'Startup of program
  89.     ' Enable error handling
  90.         On Error GoTo E_AppInitialize
  91.  
  92.     ' Setup local variables...
  93.     
  94.         Dim L_dDDSD As DDSURFACEDESC           ' Utility surface description
  95.         Dim L_dDDSC As DDSCAPS                 ' Utility display capabilities description
  96.         Dim L_oD3DIM As IDirect3D2             ' Utility Direct3DIM interface for retrieving drivers
  97.         Dim L_dDDCK As DDCOLORKEY              ' Color key for applying to various surfaces
  98.         
  99.     ' Initialize DirectDraw interface instance ...
  100.         ' Create DirectDraw instance
  101.         DirectDrawCreate ByVal 0&, G_oDDInstance, Nothing
  102.  
  103.         ' Check instance existance, terminate if missing
  104.         If G_oDDInstance Is Nothing Then
  105.            AppError 0, "Could not create DirectDraw instance", "AppInitialize"
  106.            Exit Sub
  107.         End If
  108.          
  109.         ' Set cooperation mode of DirectX
  110.         G_oDDInstance.SetCooperativeLevel fMain.hWnd, DDSCL_EXCLUSIVE Or DDSCL_FULLSCREEN
  111.         
  112.         ' Set display mode
  113.         G_oDDInstance.SetDisplayMode 640, 480, 16
  114.         ' Initialize primary surface description
  115.         With L_dDDSD
  116.             ' Get Structure size
  117.             .dwSize = Len(L_dDDSD)
  118.             ' Structure uses Surface Caps and count of BackBuffers
  119.             .dwFlags = DDSD_CAPS Or DDSD_BACKBUFFERCOUNT
  120.             ' Structure describes a flippable (buffered) surface
  121.             .DDSCAPS.dwCaps = DDSCAPS_PRIMARYSURFACE Or DDSCAPS_FLIP Or DDSCAPS_COMPLEX Or DDSCAPS_SYSTEMMEMORY
  122.             ' Structure uses one BackBuffer
  123.             .dwBackBufferCount = 1
  124.          End With
  125.     
  126.         ' Create primary surface from structure
  127.         G_oDDInstance.CreateSurface L_dDDSD, G_oDDPrimary, Nothing
  128.  
  129.         ' Check primary existance, terminate if missing
  130.         If G_oDDPrimary Is Nothing Then
  131.            AppError 0, "Could not create primary surface", "AppInitialize"
  132.            Exit Sub
  133.         End If
  134.     
  135.     ' Initialize backbuffer from primary ...
  136.     
  137.         ' Set surface description to backbuffer creation
  138.         L_dDDSD.dwFlags = DDSD_CAPS
  139.         L_dDDSD.DDSCAPS.dwCaps = DDSCAPS_BACKBUFFER
  140.         
  141.         ' Create backbuffer from frontbuffer
  142.         G_oDDPrimary.GetAttachedSurface L_dDDSD.DDSCAPS, G_oDDBackbuffer
  143.         ' Check backbuffer existance, terminate if missing
  144.         If G_oDDBackbuffer Is Nothing Then
  145.            AppError 0, "Could not create backbuffer", "AppInitialize"
  146.            Exit Sub
  147.         End If
  148.  
  149.         
  150.     ' Initialize windows for displaying various effects
  151.         Call CreateWindows
  152.             
  153.     ' Initialize Direct3DRM interface instance ...
  154.     
  155.         ' Create Direct3DRM instance
  156.         Direct3DRMCreate G_oD3DInstance
  157.     
  158.         ' Check instance existance, terminate if missing
  159.         If G_oD3DInstance Is Nothing Then
  160.            AppError 0, "Could not create D3DRM instance", "AppInitialize"
  161.            Exit Sub
  162.         End If
  163.     
  164.     ' Initialize Direct3DRM driver ...
  165.     
  166.         ' Get a Direct3D immediate object from the existing DirectDraw object
  167.         Set L_oD3DIM = G_oDDInstance
  168.     
  169.         ' Set error handler to local for enumeration only
  170.         On Error Resume Next
  171.         
  172.         ' Start the callback that does the driver enumeration
  173.         L_oD3DIM.EnumDevices AddressOf EnumDeviceCallback, 0
  174.     
  175.         ' Catch any error resulting from the enumeration and terminate
  176.         If err.Number > 0 Then
  177.            AppError err.Number, err.Description, "AppInitialize"
  178.            Exit Sub
  179.         End If
  180.     
  181.